home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 013 / disklbl.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-04-07  |  2.9 KB  |  70 lines
  1. 0  CLS:PRINT:PRINT:PRINT
  2. 5     PRINT"   DISKETTE LABEL PROGRAM FOR THE IDS-DATAPRODUCTS PRINTER SERIES"
  3. 10    PRINT
  4. 20    PRINT"        ORIGINAL PROGRAM DEVELOPED BY LOREN SACHER, 1/31/84"
  5. 22    PRINT
  6. 30    PRINT"      MODIFIED FOR IDS PRINTERS, ENHANCED PRINT, ETC. ON 1/12/85"
  7. 33    PRINT
  8. 40    PRINT"        BY HOWARD LUBERT - THE COMPUTER BANK - PHILADELPHIA, PA"
  9. 42    PRINT:PRINT
  10. 50    PRINT"       PROGRAM REQUIRES THE FOLLOWING FILES ON THE LOGGED DRIVE;"
  11. 51    PRINT"          BASICA.COM - COMMAND.COM - SORT.COM - LABELIDS.BAS"
  12. 52    PRINT
  13. 55    PRINT"       PROGRAM WILL RUN MUCH FASTER IF ALL FILES ARE LOADED TO A"
  14. 56    PRINT"                               RAM DISK "
  15. 60    PRINT
  16. 65    PRINT"             DESIGNED TO USE 5 INCH BY 1 7/16 INCH LABELS"
  17. 70  FOR I=1 TO 2750:NEXT I:CLS
  18. 100  'DISKETTE LABEL MAKER FOR IDS DATAPRODUCTS PRINTERS
  19. 110  '                     ***********************************
  20. 120  '                     ***DISK LABEL MAKER USEING SHELL***
  21. 130  '                     ***********************************
  22. 140  ON ERROR GOTO 640
  23. 150  KEY OFF
  24. 170  DIM A$(100):DEFINT A-B,W:WDT = 1
  25. 180  CLS:LOCATE 25,1:PRINT" Press <ESC> to ABORT program ";
  26. 190  LOCATE 6,1,0:PRINT" Place Diskette to be labelled in DRIVE B: ";
  27. 200  LOCATE 8,1,0:PRINT" Hit <RETURN> to print label"
  28. 210  AN$ = INKEY$: IF AN$ = "" THEN 210
  29. 220  IF AN$ = CHR$(27) THEN LPRINT CHR$(24):CLS:END
  30. 230  IF AN$ = CHR$(13) THEN 240 ELSE 210  'CHR$13)=<CR>
  31. 240  '
  32. 250  '                    ************************
  33. 260  '                    ***READ DISK AND SORT***
  34. 270  '                    ************************
  35. 280  DEF SEG:AX = PEEK(&H30): BX= PEEK(&H31) 'save offset to start of program
  36. 290  LOCATE 10,1,0:PRINT" Reading Diskette to create label";
  37. 300  SHELL "DIR B:| SORT > DIR.DAT"
  38. 310  DEF SEG : POKE &H30,AX:POKE &H31,BX
  39. 320  '                   ******************************
  40. 330  '                   ***READ DIRECTORY FROM FILE***
  41. 340  '                   ******************************
  42. 350  OPEN "DIR.DAT" FOR INPUT AS 1:A = 1
  43. 360  WHILE NOT EOF(1)
  44. 370  LINE INPUT #1,AA$:IF LEN(AA$) <> 0 THEN A$(A)= AA$ ELSE 390
  45. 380  A = A + 1
  46. 390  WEND
  47. 400  CLOSE
  48. 410  '                   *********************
  49. 420  '                   ***PRINTER ROUTINE***
  50. 430  '                   *********************
  51. 440  LOCATE 12,1:PRINT" Printing Disk Label";
  52. 450  LPRINT CHR$(30);:WIDTH "LPT1:",60:   'set 12 cpi
  53. 460  LPRINT CHR$(27);"j,0,$";:LPRINT CHR$(27);"B,6,$";
  54. 480  LPRINT CHR$(27); "L,69,63,$";  'SET FORM LENGTH TO 1 7/16s
  55. 490  IF MID$(A$(4),10,3)="LBL" THEN LPRINT "Disk #"LEFT$(A$(4),3) SPC(10);'disk #
  56. 500  IF INSTR(A$(3),"has no") THEN LPRINT CHR$(1);:LPRINT"NAME: ";:LPRINT CHR$(2);:GOTO 530;    'no volume name on disk
  57. 510  LPRINT CHR$(1);:LPRINT RIGHT$(A$(3),12);:LPRINT CHR$(2);  'print volume
  58. 530  LPRINT STRING$(54,"-")
  59. 540  FOR B = 4 TO A
  60. 550  IF B = 36 THEN LPRINT" "
  61. 560  AN$ = INKEY$:IF AN$ <> CHR$(27) THEN 570 ELSE IF AN$ = CHR$(27) THEN 220
  62. 570  LPRINT LEFT$(A$(B),13),
  63. 580  NEXT
  64. 585  IF LPOS(0) > 1 THEN LPRINT          'return to print last line
  65. 600  LPRINT MID$(A$(1),8,31);            'available space info
  66. 620  LPRINT CHR$(12)                     'form feed
  67. 630  GOTO 180
  68. 640  IF ERR = 24 THEN BEEP:LOCATE 25,1,0:PRINT"TURN ON THE PRINTER!";:RESUME 350
  69. 650  ON ERROR GOTO 0
  70.